(define-module (mach mmap)
  #:use-module (mach ffi))

;; 'prot' protection flags for mmap.
(define-bitfield mmap-prot-flags
  (PROT_NONE #x00)
  (PROT_READ #x04)
  (PROT_WRITE #x02)
  (PROT_EXEC #x01))

;; Specifies the type of the object in mmap 'flags'.
(define-bitfield mmap-map-flags
  (MAP_FILE #x0001)
  (MAP_TYPE #x000f)
  (MAP_SHARED #x0010)
  (MAP_PRIVATE #x0000)
  (MAP_FIXED #x0100)
  (MAP_NOEXTEND #x0200)
  (MAP_HASSEMAPHORE #x0400)
  (MAP_INHERIT #x0800)
  (MAP_ANON #x0002))

(define-ffi ("mmap" %mmap)
  (ffi:pointer identity)
  (address ffi:pointer identity)
  (length ffi:unsigned-int identity) ;; XXX size_t?
  (protection ffi:int (unwrap-bits mmap-prot-flags))
  (flags ffi:int (unwrap-bits mmap-map-flags))
  (filedes ffi:int identity)
  (offset ffi:off_t identity)) ;; XXX check

;; TODO: these two procedures should perhaps
;; raise conditions instead?  Preferably something
;; more specific than 'system-error ...

(define (mmap address length protection flags filedes offset)
  "Map files or devices into memory.  If address is 0, it is ignored.
On success, return the pointer.  On failure, return #f."
  (let ((ptr (%mmap address length protection flags filedes offset)))
    ;; Mmap returns -1 in case of error
    ;; XXX 64-bit
    (if (= (pointer-address ptr) #xffffffff)
      #f
      ptr)))

(define-ffi ("munmap" %munmap) (ffi:int identity)
  (address ffi:pointer identity)
  (length ffi:unsigned-int identity))

(define (munmap pointer length)
  "Remove the mapping starting at @var{pointer} and @var{length} long.
On success, return #t.  On failure, return #f. "
  (cond ((and (exact-integer? length) (= length 0)) #t)
        ((null-pointer? pointer) #f)
        ;; In case of success, munmap returns 0.
        (#t (= (%munmap pointer length)))))
